home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 34 / Mac Magazin and MacEasy Magazine CD - Issue 34.iso / Grafik & Text / Alpha ƒ / Tcl / Menus / colorsMenu.tcl < prev    next >
Text File  |  1996-12-21  |  8KB  |  399 lines
  1. #===============================================================================
  2. # Color menu and support routines
  3. #
  4.  
  5. if $startingUp {
  6.     set colorMenu        "•137"
  7.     addMenu colorMenu
  8.     return
  9. }
  10.  
  11. proc colorMenu {} {}
  12.  
  13. menu -n $colorMenu -p colorMenuProc {
  14.     {menu -n Color -p colorMenuProc {
  15.         foreground
  16.         blue
  17.         cyan
  18.         green
  19.         magenta
  20.         red
  21.         white
  22.         yellow
  23.         "(-"
  24.         color_9
  25.         color_10
  26.         color_11
  27.         color_12
  28.         color_13
  29.         color_14
  30.         color_15
  31.     }}
  32.  
  33.     {menu -n Style -p colorMenuProc {
  34.         "/B<U<Obold"
  35.         condense
  36.         extend
  37.         italic
  38.         normal
  39.         outline
  40.         shadow
  41.         "underline"
  42.     }}
  43.     "(-"
  44.     "/f<SredWord"
  45.     "/f<S<IredMark"
  46.     "/g<SblueWord"
  47.     "/g<S<IblueMark"
  48.     "/h<SgreenWord"
  49.     "/h<S<IgreenMark"
  50.     "underlineWord"
  51.     "(-"
  52.     "/H<UhyperText"
  53.     "urlLink"
  54.     "mailtoLink"
  55.     "linkToFile"
  56.     "/k<SlinkToMark"
  57.     "/k<S<IlinkToFile&Mark"
  58.     "(-"
  59.     "listColors"
  60.     "removeColors"
  61. }
  62.     
  63. proc redWord {} { colorSelect 5 0 ; centerRedraw }
  64.  
  65. proc blueWord {} { colorSelect 1 0 ; centerRedraw }
  66.  
  67. proc greenWord {} { colorSelect 3 0 ; centerRedraw }
  68.  
  69. proc redMark {} {
  70.     colorSelect 5 0
  71.     setNamedMark
  72.     centerRedraw
  73. }
  74. proc blueMark {} {
  75.     colorSelect 1 0
  76.     setNamedMark
  77.     centerRedraw
  78. }
  79. proc greenMark {} {
  80.     colorSelect 3 0
  81.     setNamedMark
  82.     centerRedraw
  83. }
  84.  
  85. proc underlineWord {} {
  86.     insertColorEscape [getPos] 15
  87.     insertColorEscape [selEnd] 12
  88.     centerRedraw
  89. }
  90.  
  91. proc colorMenuProc {menu item} {
  92.  
  93.     switch $item {
  94.         black   {colorSelect $item 0}
  95.         blue    {colorSelect $item 0}
  96.         cyan    {colorSelect $item 0}
  97.         green   {colorSelect $item 0}
  98.         magenta {colorSelect $item 0}
  99.         red     {colorSelect $item 0}
  100.         white   {colorSelect $item 0}
  101.         yellow  {colorSelect $item 0}
  102.     
  103.         bold      {colorSelect  $item 12}
  104.         condense  {colorSelect  $item 12}
  105.         extend    {colorSelect $item 12}
  106.         italic    {colorSelect $item 12}
  107.         normal    {colorSelect $item 12}
  108.         outline   {colorSelect $item 12}
  109.         shadow    {colorSelect $item 12}
  110.         underline {colorSelect $item 12}    
  111.  
  112.         hyperText     {markAsHyper}
  113.         listColors    {listColorEscapes}
  114.         removeColors  {removeColorEscapes}
  115.         
  116.         default {eval $item}
  117.     }
  118. }
  119.  
  120. proc listColorEscapes {} {
  121.     set colors [getColors]
  122.     
  123.     set res "    Pos  Code  Hypertext\n"
  124.     foreach item $colors {
  125.         set off [lindex $item 0]
  126.         set code [lindex $item 1]
  127.         set cmd [lreplace $item 0 1]
  128.         if {[string length $cmd]>1} {
  129.             append res [format "%7d  %3d  %s\n" $off $code $cmd]
  130.         } else {
  131.             append res [format "%7d  %3d\n" $off $code]
  132.         }
  133.     }
  134.     
  135.     if {[llength $colors]>0} {        
  136.         new -n "* Color Codes *"
  137.         insertText $res
  138.         goto 0
  139.         catch {shrinkWindow 2}
  140.         set win [car [winNames -f]]
  141.         setWinInfo -w $win dirty 0
  142.         setWinInfo -w $win read-only 1
  143.     
  144.     } else {
  145.         message "No color codes found"
  146.     }
  147. }
  148.     
  149.  
  150. #===============================================================================
  151.  
  152. set lastHyper {} 
  153.  
  154. proc markAsHyper {} {
  155.     global lastHyper
  156.     
  157.     set from [getPos]
  158.     set to [selEnd]
  159.     if {$from == $to} {
  160.         beep
  161.         return
  162.     }
  163.     set lastHyper [prompt "Hyper-text?" $lastHyper]
  164.     insertColorEscape $from 3
  165.     insertColorEscape $from 15 $lastHyper
  166.     insertColorEscape $to 12
  167.     insertColorEscape $to 0
  168.     centerRedraw
  169. }
  170.  
  171. proc colorSelect {ind ind2} {
  172.     set from [getPos]
  173.     set to [selEnd]
  174.     
  175.     insertColorEscape $from $ind
  176.     insertColorEscape $to $ind2
  177. }
  178.  
  179.  
  180. proc linkToFile {{path {}} {from {}} {to {}}} {    
  181.     global HOME
  182.     if {$from == {}} { set from [getPos] }
  183.     if {$to == {}} { set to [selEnd] }
  184.     if {$from == $to} {
  185.         beep
  186.         return
  187.     }
  188.  
  189.     if {$path == {}} {
  190.         set path [getfile "Choose target of hyperlink:"]
  191.         # make path relative to Alpha's home folder
  192.         set qHome [quoteExpr $HOME]
  193.         regsub "$qHome" $path {$HOME} path
  194.     }
  195.  
  196.     set cmd "edit \"$path\""
  197.     insertColorEscape $from 3
  198.     insertColorEscape $from 15 $cmd
  199.     insertColorEscape $to 12
  200.     insertColorEscape $to 0
  201.     centerRedraw
  202. }
  203.  
  204. proc linkToMark {{mark {}} {from {}} {to {}}} {    
  205.     if {$from == {}} { set from [getPos] }
  206.     if {$to == {}} { set to [selEnd] }
  207.     if {$from == $to} {
  208.         beep
  209.         return
  210.     }
  211.     
  212.     set mark [listpick -p "Choose a Mark:" -L [list $mark] [getNamedMarks -n]]
  213.  
  214.     set cmd "gotoMark \"$mark\""
  215.     insertColorEscape $from 3
  216.     insertColorEscape $from 15 $cmd
  217.     insertColorEscape $to 12
  218.     insertColorEscape $to 0
  219.     centerRedraw
  220. }
  221.  
  222. proc urlLink {{from {}} {to {}}} {    
  223.     if {$from == {}} { set from [getPos] }
  224.     if {$to == {}} { set to [selEnd] }
  225.     if {$from == $to} {
  226.         beep
  227.         return
  228.     }
  229.  
  230.     set text [getText $from $to]
  231.  
  232.     set cmd "sendUrl \"$text\""
  233.     insertColorEscape $from 3
  234.     insertColorEscape $from 15 $cmd
  235.     insertColorEscape $to 12
  236.     insertColorEscape $to 0
  237.     centerRedraw
  238. }
  239.  
  240. proc mailtoLink {{from {}} {to {}}} {    
  241.     if {$from == {}} { set from [getPos] }
  242.     if {$to == {}} { set to [selEnd] }
  243.     if {$from == $to} {
  244.         beep
  245.         return
  246.     }
  247.  
  248.     set text [getText $from $to]
  249.  
  250.     set cmd "sendUrl \"mailto:$text\""
  251.     insertColorEscape $from 3
  252.     insertColorEscape $from 15 $cmd
  253.     insertColorEscape $to 12
  254.     insertColorEscape $to 0
  255.     centerRedraw
  256. }
  257.  
  258. proc linkToFile&Mark {{path {}} {mark {}} {from {}} {to {}}} {
  259.     global HOME
  260.     if {$from == {}} { set from [getPos] }
  261.     if {$to == {}} { set to [selEnd] }
  262.     if {$from == $to} {
  263.         beep
  264.         return
  265.     }
  266.     
  267.     if {$path == {}} {
  268.         set path [getfile "Choose a file:"]
  269.         # make path relative to Alpha's home folder
  270.         set qHome [quoteExpr $HOME]
  271.         regsub "$qHome" $path {$HOME} path
  272.     }
  273.     
  274.     set current [car [winNames -f]]
  275.     
  276.     if {![catch {openFileQuietly $path}]} {
  277.         
  278.         set mark [listpick -p "Choose a mark in that file:" -L [list $mark] [getNamedMarks -n -w $path]]
  279.         
  280.         bringToFront $current
  281.         
  282.         set cmd "edit \"$path\" ; gotoMark \"$mark\""
  283.         insertColorEscape $from 3
  284.         insertColorEscape $from 15 $cmd
  285.         insertColorEscape $to 12
  286.         insertColorEscape $to 0
  287.         centerRedraw
  288.     }
  289. }
  290.  
  291. proc colorDummy {} {}
  292.  
  293. #===============================================================================
  294. # Pete's manual-marking routines
  295.  
  296. proc markManual {} {
  297.     set pos 0
  298.     while {[string length [set inds [search -f 1 -r 1 {^          } $pos]]]} {
  299.         set pos1 [lindex $inds 1]
  300.         set label [getText $pos1 [expr [nextLineStart $pos1] - 1]]
  301.         set pos2 [lineStart $pos1]
  302.         setNamedMark $label $pos2 $pos2 $pos2
  303.         set pos [expr [nextLineStart $pos1]]
  304.     }
  305. }
  306.  
  307. proc colorManualMarks {} {
  308.     goto 0
  309.     hiliteWord
  310.     endLineSelect
  311.     set from [getPos]
  312.     set to [selEnd]
  313.     insertColorEscape $from 5
  314.     insertColorEscape $from 15
  315.     insertColorEscape $to 12
  316.     insertColorEscape $to 0
  317.  
  318.     foreach mk [getNamedMarks] {
  319.         set name [lindex $mk 0]
  320.         set disp [lindex $mk 2]
  321.         set pos [lindex $mk 3]
  322.         set end [lindex $mk 4]
  323.         
  324.         goto $disp
  325.         hiliteWord
  326.         endLineSelect
  327.         set from [getPos]
  328.         set to [selEnd]
  329.         
  330.         insertColorEscape $from 5
  331.         insertColorEscape $from 15
  332.         insertColorEscape $to 12
  333.         insertColorEscape $to 0
  334.     }
  335. }
  336.  
  337. #===============================================================================
  338.  
  339. proc markAlphaCommands {} {
  340.     set pos 0
  341.     while {[string length [set inds [search -f 1 -r 1 {^• } $pos]]]} {
  342.         set pos1 [lindex $inds 1]
  343.         goto $pos1
  344.         hiliteWord
  345.         set label [getSelect]
  346.         set from [getPos]
  347.         set to [selEnd]
  348.         setNamedMark $label $pos1 $from $to
  349.         insertColorEscape $from 1
  350.         insertColorEscape $to 0
  351.         set pos [expr [nextLineStart $pos1]]
  352.     }
  353. }
  354.  
  355. #===============================================================================
  356.  
  357. proc markChanges {} {
  358.     set pos 0
  359.     while {[string length [set inds [search -f 1 -r 1 {^= } $pos]]]} {
  360.         set pos1 [lindex $inds 1]
  361.         goto $pos1
  362.         endLineSelect
  363.         redWord
  364.         set pos [expr [nextLineStart $pos1]]
  365.     }
  366. }
  367.  
  368. #===============================================================================
  369.  
  370.  
  371. proc listNamedMarks {} {
  372.  
  373.     set nm [car [winNames -f]]
  374.     
  375.     set res "    Pos    Disp     End  Name\n"
  376.     append res "------- ------- -------  --------------------\n"
  377.     foreach mk [getNamedMarks] {
  378.         set name [lindex $mk 0]
  379.         set disp [lindex $mk 2]
  380.         set pos [lindex $mk 3]
  381.         set end [lindex $mk 4]
  382.         append res [format "%7d %7d %7d  %s\n" $pos $disp $end $name]
  383.     }
  384.     
  385.     if {[llength [getNamedMarks]]>0} {        
  386.         new -n "* Named Marks *"
  387.         insertText $res
  388.         goto 0
  389.         catch {shrinkWindow 2}
  390.         set win [car [winNames -f]]
  391.         setWinInfo -w $win dirty 0
  392.         setWinInfo -w $win read-only 1
  393.     
  394.     } else {
  395.         message "No color codes found"
  396.     }
  397. }
  398.  
  399.